home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d27 / matenc.arc / CPP1580.CLP < prev    next >
Text File  |  1991-12-04  |  4KB  |  88 lines
  1.  CPP1580:    PGM        PARM(&PGM &FILE &MBR &REPLACE &AUT)
  2.  
  3.              /*         Program - CPP1580  */
  4.              /*         CPP for command ENCPGM  */
  5.              /*         Encapsulate program from database file. */
  6.  
  7.              DCL        &PGM     *CHAR 20 /* Program.Library name */
  8.              DCL        &FILE    *CHAR 20 /* File.Library name */
  9.              DCL        &MBR     *CHAR 10 /* Member name */
  10.              DCL        &REPLACE *CHAR 01 /* Program option */
  11.              DCL        &AUT     *CHAR 01 /* Keep same authority */
  12.              DCL        &NEWLIB  *CHAR 10 /* New library name */
  13.              DCL        &P       *CHAR 10 /* Program name */
  14.              DCL        &PL      *CHAR 10 /* Program's library */
  15.              DCL        &F       *CHAR 10 /* File name */
  16.              DCL        &FL      *CHAR 10 /* File's library */
  17.  
  18.              DCL        &OBJEXIST *CHAR 01
  19.              DCL        &TIME    *CHAR 006
  20.              DCL        &CNT    *DEC  003
  21.              DCL        &MSGID  *CHAR 007
  22.              DCL        &MSGDTA *CHAR 132
  23.              MONMSG     MSGID(CPF0000) EXEC(GOTO RCVMSG)
  24.  
  25.  RTVSYSVAL:  RTVSYSVAL  SYSVAL(QTIME) RTNVAR(&TIME)
  26.  
  27.              CHGVAR     VAR(&F) VALUE(%SST(&FILE 01 10))
  28.              CHGVAR     VAR(&FL) VALUE(%SST(&FILE 11 10))
  29.              CHGVAR     VAR(&P) VALUE(%SST(&PGM 01 10))
  30.              CHGVAR     VAR(&PL) VALUE(%SST(&PGM 11 10))
  31.  
  32.              CHKOBJ     OBJ(%SST(&PGM 01 10).%SST(&PGM 11 10)) +
  33.                           OBJTYPE(*PGM)
  34.              MONMSG     MSGID(CPF9810) EXEC(GOTO RCVMSG)
  35.              MONMSG     MSGID(CPF9801) EXEC(DO)
  36.                RCVMSG
  37.                IF         (&AUT *EQ '1') DO
  38.                  SNDPGMMSG  MSG('Program ' *CAT %SST(&PGM 01 10) *TCAT +
  39.                               '.' *CAT %SST(&PGM 11 10) *BCAT 'doesn''t +
  40.                               exist.  GRTOBJAUT failed') MSGTYPE(*DIAG)
  41.                  CHGVAR     VAR(&AUT) VALUE('0')
  42.                ENDDO
  43.                CHGVAR     VAR(&OBJEXIST) VALUE('0')
  44.                GOTO       REPLACE
  45.              ENDDO
  46.  DUPLICATE:  IF         (&REPLACE *EQ '0') DO
  47.              SNDPGMMSG  MSG('Program ' *CAT %SST(&PGM 01 10) *TCAT +
  48.                           '.' *CAT %SST(&PGM 11 10) *BCAT 'already +
  49.                           exists.') MSGTYPE(*DIAG)
  50.              RETURN
  51.              ENDDO
  52.  
  53.              CHGVAR     VAR(&OBJEXIST) VALUE('1')
  54.  
  55.  REPLACE:    IF    ((&REPLACE *EQ '1') *AND (&OBJEXIST *EQ '1')) DO
  56.                CHGVAR     VAR(&NEWLIB) VALUE('Q38' *CAT &TIME)
  57.                CRTLIB     LIB(&NEWLIB) TEXT('Library created by ENCPGM +
  58.                             at' *BCAT &TIME)
  59.                MONMSG     MSGID(CPF2111)
  60.    CRTPGM:     CALL       PGM(QSCCRTPG) PARM(&P &NEWLIB &F &FL &MBR)
  61.    GRTLIKE:    IF         (&AUT *EQ '1') DO
  62.                  GRTOBJAUT  OBJ(&P.&NEWLIB) OBJTYPE(*PGM) REFOBJ(&P.&PL)
  63.                ENDDO
  64.                RNMOBJ     OBJ(&P.&PL) OBJTYPE(*PGM) NEWOBJ(&NEWLIB)
  65.                MOVOBJ     OBJ(&P.&NEWLIB) OBJTYPE(*PGM) TOLIB(&PL)
  66.                DLTPGM     PGM(&NEWLIB.&PL)
  67.                DLTLIB     LIB(&NEWLIB)
  68.              ENDDO
  69.              ELSE       DO
  70.    ENCPGM:     CALL       PGM(QSCCRTPG) PARM(&P &PL &F &FL &MBR)
  71.              ENDDO
  72.  
  73.  RCVMSG:     /*         Receive and forward program messages. */
  74.              RCVMSG     RMV(*YES) MSGDTA(&MSGDTA) MSGID(&MSGID)
  75.              IF         (&MSGID *EQ ' ')  RETURN
  76.              IF         (%SST(&MSGID 1 2) *EQ 'CP'  +
  77.                      *OR %SST(&MSGID 1 3) *EQ 'MCH')  DO
  78.              IF         (&MSGDTA *EQ ' ') SNDPGMMSG  MSGID(&MSGID) +
  79.                           MSGF(QCPFMSG) TOPGMQ(*PRV) MSGTYPE(*DIAG)
  80.              ELSE       SNDPGMMSG  MSGID(&MSGID) MSGF(QCPFMSG) +
  81.                           MSGDTA(&MSGDTA) TOPGMQ(*PRV) MSGTYPE(*DIAG)
  82.              CHGVAR     VAR(&CNT) VALUE(&CNT + 1)
  83.              IF         ((&CNT *GT 0) *AND (&CNT *LT 10)) GOTO RCVMSG
  84.                           /* MAXMSG(10) */
  85.              ENDDO
  86.  
  87.  ENDPGM:     ENDPGM
  88.